home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / xlib30.arj / EXAMP3.BAS < prev    next >
BASIC Source File  |  1993-12-18  |  2KB  |  70 lines
  1. 'The following Microsoft BASIC 7.0 program should be linked with EXAMP3.ASM
  2. 'and XLIB.LIB.  The best approach would likely be to combine EXAMP3.ASM with
  3. 'XLIB.LIB to form a second library.  This second library would then be lined 
  4. 'with the program below.  The BASIC program first initializes XLIB.  Next, it 
  5. 'creates a single precision array.  A control block for SUMARRAY is then 
  6. 'constructed and the call to SUMARRAY is executed.  Finally, the condition 
  7. 'code in the control block is inspected and results are printed.
  8.  
  9. DEFINT A-Z
  10.  
  11. 'Declare XLIB procedures
  12. DECLARE FUNCTION XLIBMEMREQ& ()
  13. DECLARE FUNCTION INITXLIB& ()
  14. DECLARE FUNCTION XLIBCONFIG% ()
  15.  
  16. 'Declare procedures in the library linked with XLIB
  17. DECLARE FUNCTION LINADR& (SEG VARIABLE AS ANY)
  18. DECLARE SUB SUMARRAY (SEG VARIABLE AS ANY)
  19.  
  20. 'Structure for the control block
  21. TYPE ARRAYDATA
  22.   CONDCODE AS LONG      'Location to receive any error codes
  23.   N AS LONG             'Number of elements to be summed
  24.   ADDRESS AS LONG       'Linear address of the array
  25.   SUM AS SINGLE         'Location for array sum
  26. END TYPE
  27.  
  28. 'Check XLIBCONFIG to see if XLIB has already been initialized.  If not then
  29. 'call XLIBMEMREQ to find amount of conventional memory needed by XLIB and
  30. 'release at least this amount with the BASIC SETMEM function.  XLIBMEMREQ
  31. 'returns with sign bit of DX set if an error occurred.  The error is then
  32. 'identified by AX.  XLIB will not be terminated upon completion of this
  33. 'program in the Microsoft QBX environment; therefore, initialization is
  34. 'required only once within the environment.
  35. IF XLIBCONFIG = 0 THEN
  36.   TEMP& = XLIBMEMREQ
  37.   IF TEMP& >= 0& THEN
  38.     IF TEMP& > 0 THEN TEMP& = SETMEM(-TEMP& - 16&)
  39.     TEMP& = INITXLIB                 'INITXLIB error code returned in TEMP&
  40.   ELSE
  41.     TEMP& = TEMP& AND &H7FFFFFFF     'Mask sign bit to leave error code only
  42.   END IF
  43.   IF TEMP& THEN
  44.     PRINT "Library initialization error:  "; HEX$(TEMP&)
  45.     END
  46.   END IF
  47. END IF
  48.  
  49. DIM A(100) AS SINGLE
  50. DIM AD AS ARRAYDATA
  51.  
  52. FOR I = 0 TO 100            'Assign numbers to array
  53.   A(I) = I
  54. NEXT I
  55.  
  56. AD.CONDCODE = 0&            'Clear the error code
  57. AD.N = 50&                  'Sum first 50 elements
  58. AD.ADDRESS = LINADR(A(0))   'Calculate and record linear address of A(0)
  59.  
  60. CALL SUMARRAY(AD)
  61.  
  62. IF AD.CONDCODE THEN
  63.   PRINT "Error: "; HEX$(AD.CONDCODE)
  64. ELSE
  65.   PRINT "Sum: "; AD.SUM     'Should equal 1225
  66. END IF
  67.  
  68. END
  69.  
  70.